home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / ms_dos / happysrc / pctype.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-07-08  |  31.5 KB  |  820 lines
  1. /*********************************************************************
  2.  *
  3.  *     *** HAPPy Pascal compiler ***
  4.  *
  5.  *          型の処理
  6.  *
  7.  *             void typ(Set fsys,stp **fsp,int *fsize)
  8.  *
  9.  *
  10.  *                Copyright (c) H.Asano 1992
  11.  *
  12.  *********************************************************************/
  13.  
  14. #define EXTERN extern
  15. #include <string.h>
  16. #include "pascomp.h"
  17.  
  18. extern void pcerr(int,char*) ;
  19. extern char *inttoch(long)   ;
  20. extern Set  *orset(Set*,Set*) ;
  21. extern Set  *mkset(Set*,int,...) ;
  22. extern Set  *dfset(Set*,Set*) ;
  23. extern void insymbol(void) ;
  24. extern void skip(Set)  ;
  25. extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
  26. extern void enterid(ctp*) ;
  27. extern ctp  *searchid(Set) ;
  28. extern ctp  *searchsection(ctp*) ;
  29. extern int  align(stp*,int) ;
  30. extern boolean string(stp*) ;
  31. extern void constant(Set, stp**, union valu*); 
  32. extern void getbounds(stp*,long*,long*) ;
  33. extern boolean compatible(stp*,stp*) ;
  34. extern void *Malloc(int) ;
  35. extern void applied(ctp*,int) ;
  36.  
  37. static boolean simpletype(Set,stp**,int*) ;
  38. static stp  *enumtype(Set) ;
  39. static stp  *subrtype1(Set,ctp*) ;
  40. static stp  *subrtype2(Set,ctp*) ;
  41. static boolean complextype(Set,stp**) ;
  42. static stp *pointertype(Set) ;        
  43. static boolean packedtype(Set) ;
  44. static stp *recordtype(Set,boolean,boolean*);
  45. static boolean fieldlist(Set,stp**,int*) ;
  46. static boolean varfield(Set,stp**,int*)  ;
  47. static boolean varelement(Set,stp*,stp**,int**);
  48. static stp *settype(Set,boolean) ;
  49. static stp *filetype(Set,boolean) ;
  50. static stp *arraytype(Set,boolean,boolean*) ; 
  51.  
  52. /**************************************/
  53. /*     typ() : 型の処理メイン         */
  54. /**************************************/
  55. boolean typ(Set fsys,stp **fsp,int *fsize)
  56. {
  57.   boolean fileflag = false ;
  58.   Set ws ;
  59.  
  60.      if(! inset(typebegsys,sy)) {
  61.       pcerr(10,"") ;                    /* 型の記述に誤りがある       */
  62.       ws = fsys ;
  63.       orset(&ws,&typebegsys) ;
  64.       skip(ws)               ;          /* fsys+typebegsysまで読み飛ばし */
  65.      }
  66.  
  67.      if(inset(typebegsys,sy)) {         /* symbolがtypebegsysにある時 */
  68.       if(inset(simptypebegsys,sy))      /*  単純型の時                */
  69.        fileflag = simpletype(fsys,fsp,fsize) ;/*    単純型の処理      */
  70.       else
  71.        fileflag = complextype(fsys,fsp) ;     /*  構造型の処理        */
  72.                                          
  73.      }
  74.      else *fsp = nil  ;
  75.  
  76.      if(*fsp) {
  77.       *fsize = (*fsp)->size ;
  78.       (*fsp)->assignflag = !fileflag ;  /* 代入可能フラグ設定         */
  79.      }
  80.      else *fsize = 1  ;
  81.  
  82.      return(fileflag) ;
  83. }
  84.  
  85. /***********************************************/
  86. /*  simpletype() :  単純型の処理               */
  87. /*                                             */
  88. /*    単純型 ::= 列挙型 | 部分範囲型 | 型名    */
  89. /*      列挙型      ::=  (名前,名前･･･)        */
  90. /*      部分範囲型  ::= 定数   .. 定数|定数名  */
  91. /*      部分範囲型  ::= 定数名 .. 定数名|定数  */
  92. /*      型名        ::= 名前                   */
  93. /*                                             */
  94. /***********************************************/
  95. static boolean simpletype(Set fsys,stp **fsp,int *fsize)
  96. {
  97.   stp *lsp ;
  98.   ctp *lcp ;
  99.   boolean fileflag = false ;
  100.   Set ws ;
  101.  
  102.      *fsize = 1 ;
  103.      if(! inset(simptypebegsys,sy)) { 
  104.       pcerr(1,"") ;                     /* 単純な型に誤りがある       */
  105.       ws = fsys ;
  106.       orset(&ws,  &simptypebegsys) ;
  107.       skip(ws) ;                        /* fsys+simtypebegsysまで読み飛ばし */
  108.      }
  109.  
  110.      if(inset(simptypebegsys,sy)) {     /* 単純型の始めのsymbolの時  */
  111.       switch(sy) {
  112.        case  lparent  :                 /*  (                        */
  113.          lsp = enumtype(fsys) ;         /*    列挙型の処理           */
  114.          break         ;
  115.        case  ident    :                 /* 名前                      */
  116.          mkset(&ws, konst,types, -1) ;
  117.          lcp = searchid(ws)          ;  /*  定数か型名から名前を探す */
  118.          applied(lcp,level)          ;  /*  引用名チェーン           */
  119.          insymbol()                  ;  /*  次のsymbolを読んでおく   */
  120.          if(lcp->klass == konst) {      /*  定数名                   */
  121.           lsp = subrtype1(fsys,lcp);    /*    範囲型1の処理          */
  122.          }
  123.          else {                         /*  型名                     */
  124.           lsp = lcp->idtype ;
  125.           if(lsp) {
  126.            *fsize = lsp->size ;
  127.            fileflag=!(lsp->assignflag); /* 代入可能とfileありは反転関係*/
  128.           }  
  129.          }
  130.          break ;
  131.        default :                        /*  定数                      */
  132.          lsp = subrtype2(fsys,lcp) ;    /*    範囲型2の処理           */
  133.       }
  134.  
  135.       if((lsp) && (lsp->form == subrange)
  136.          && (lsp->sf.su.rangetype) ) 
  137.        if(lsp->sf.su.rangetype == realptr) /* 範囲型の元の型が実数型  */
  138.         pcerr(109,"") ;                 /* 範囲型は実数では駄目       */
  139.        else 
  140.         if(lsp->sf.su.min > lsp->sf.su.max) 
  141.          pcerr(102,"")  ;               /* 下限が上限より大きい       */
  142.  
  143.       if(! inset(fsys,sy)) {
  144.        pcerr(6,"") ;                    /*  不当な記号が現れた        */
  145.        skip(fsys)  ;
  146.       }
  147.  
  148.       *fsp = lsp ;
  149.      }
  150.  
  151.      else *fsp = nil ;                  /* not (sy in simptypebegsys) */
  152.  
  153.      return(fileflag) ;
  154. }
  155.  
  156. /****************************************/
  157. /* enumtype() : 列挙型の処理            */
  158. /*   列挙型 := (名前,名前,名前,･････)   */
  159. /****************************************/
  160. static stp *enumtype(Set fsys)
  161. {
  162.   int ttop ;
  163.   stp *lsp ;
  164.   ctp *lcp, *lcp1 = nil ;
  165.   int lcnt = 0    ;                     /* 各名前の値生成用のカウンタ */
  166.   Set ws ;
  167.  
  168.      ttop = top  ;                      /* 今のdisplayのtopを退避     */
  169.      while(display[top].occur != blck)  /* blockの水準をサーチ        */
  170.       top-- ;
  171.      lsp = (stp*)Malloc(sizeof(stp)) ;
  172.      lsp->form = scalar  ;
  173.      lsp->size = intsize ;
  174.      lsp->sf.sc.scalkind = declared ;
  175.  
  176.      do {
  177.       insymbol() ;
  178.       if(sy == ident) {                 /* 各要素は名前である         */
  179.        lcp = mkctp(id,konst,lsp,lcp1) ; /* 名前のエリアを確保         */
  180.        lcp->n.values.ival = lcnt++ ;    /* 各名前の値を入れる         */
  181.        enterid(lcp)          ;          /* 名前を登録                 */
  182.        lcp1 = lcp            ;
  183.        insymbol()            ;
  184.       }
  185.       else pcerr(2,"")       ;          /* 名前がない                 */
  186.  
  187.       mkset(&ws,comma,rparent,-1) ;
  188.       orset(&ws, &fsys)      ;
  189.       if(! inset(ws,sy)) {              /* , ) fsys のsymbolでない    */
  190.        pcerr(6,"")           ;          /*  不当な記号が現れた        */
  191.        skip(ws)              ;          /* fsys , )  までで読み飛ばし */
  192.       }
  193.      } while(sy == comma)    ;          /* , で区切られるならば次へ   */
  194.  
  195.      lsp->sf.sc.fconst = lcp1;          /* 列挙型の最後の名前へのポインタ */
  196.      top = ttop              ;          /* displayの水準を元に戻す    */
  197.  
  198.      if(sy == rparent) insymbol() ;     /* ) なら次のsymbolを読む     */
  199.      else pcerr(4,"")        ;          /*  ) がない                  */
  200.  
  201.      return(lsp) ;
  202. }
  203.                
  204. /****************************************/
  205. /* subrtype1() : 範囲型1の処理          */
  206. /*   範囲型1 := 定数名..定数名|定数     */
  207. /****************************************/
  208. static stp *subrtype1(Set fsys, ctp *lcp)
  209. {
  210.   stp *lsp,*lsp1 ;
  211.   union valu lvalu ;
  212.  
  213.      lsp = (stp*)Malloc(sizeof(stp));
  214.      lsp->form = subrange ;
  215.      lsp->sf.su.rangetype = lcp->idtype ;
  216.      if(string(lsp->sf.su.rangetype)) { /* 定数が文字列型か調べる     */
  217.       pcerr(109,"")       ;             /*  範囲型はの型は順序型      */
  218.       lsp->sf.su.rangetype = nil ;
  219.      }
  220.      lsp->sf.su.min = lcp->n.values.ival;/* 下限値を入れる             */
  221.      lsp->size      = intsize ;
  222.  
  223.      if(sy == period2) insymbol()  ;    /*  .. の時 上限のsymbolを読む*/
  224.      else pcerr(22,"")  ;               /*  .. がない                 */
  225.      constant(fsys, &lsp1, &lvalu) ;    /*  上限の処理                */
  226.      lsp->sf.su.max = lvalu.ival   ;    /*  上限値を入れる            */
  227.      if(lsp->sf.su.rangetype != lsp1)
  228.       pcerr(107,"") ;                   /* 2つの型が一致しない        */
  229.  
  230.      return(lsp) ;
  231. }
  232.    
  233. /****************************************/
  234. /* subrtype2() : 範囲型2の処理          */
  235. /*   範囲型2 := 定数..定数|定数名       */
  236. /****************************************/
  237. static stp *subrtype2(Set fsys, ctp *lcp)
  238. {
  239.   stp *lsp,*lsp1 ;
  240.   union valu lvalu ;
  241.   Set ws ;
  242.  
  243.      lsp = (stp*)Malloc(sizeof(stp)) ;
  244.      lsp->form = subrange            ;
  245.      lsp->size = intsize             ;  /*  範囲型となれるのは整数のみ*/
  246.      ws = fsys ;
  247.      addset(ws,period2) ;
  248.      constant(ws, &lsp1, &lvalu)     ;  /* 下限値の処理               */
  249.      if(string(lsp1)) {
  250.       pcerr(109,"") ;                   /* 範囲型の型は順序型         */
  251.       lsp1 = nil    ;
  252.      }
  253.      lsp->sf.su.rangetype = lsp1     ;  /* 範囲型の元の型             */
  254.      lsp->sf.su.min       = lvalu.ival; /* 下限値の設定               */
  255.  
  256.      if(sy == period2) insymbol() ;     /* .. なら次のsymbol(上限値)  */
  257.      else pcerr(22,"")            ;     /* ..でなければ .. がない     */
  258.  
  259.      constant(fsys, &lsp1, &lvalu)   ;  /* 上限値の処理               */
  260.      lsp->sf.su.max = lvalu.ival     ;  /* 上限値の設定               */
  261.  
  262.      if(lsp->sf.su.rangetype != lsp1)   /* 上限値と下限値のタイプが違う時 */
  263.       pcerr(107,"") ;                   /*  範囲型の2つの型が不一致   */
  264.  
  265.      return(lsp) ;
  266. }
  267.  
  268. /***********************************************/
  269. /*  complextype() : 単純型以外の型の処理       */
  270. /*                                             */
  271. /*     ^ 型名                                  */
  272. /*      [packed]   array[単純型,･･･] of 型     */
  273. /*      [packed]   file of 型                  */
  274. /*      [packed]   set  of 型                  */
  275. /*      [packed]   record 欄の並び end         */
  276. /***********************************************/
  277. static boolean complextype(Set fsys,stp **fsp)
  278. {
  279.   boolean packedflag ;
  280.   boolean fileflag = false  ;
  281.  
  282.      if(sy == arrow) *fsp=pointertype(fsys)   ;         /* ポインタ型 */
  283.      else {
  284.       packedflag = packedtype(fsys) ;
  285.       switch(sy) {
  286.        case arraysy  : *fsp=arraytype(fsys,packedflag,&fileflag);
  287.                        break ;                          /* 配列型     */
  288.        case recordsy : *fsp=recordtype(fsys,packedflag,&fileflag);
  289.                        break ;                          /* レコード型 */
  290.        case setsy    : *fsp=settype(fsys,packedflag) ;  /* 集合型     */
  291.                        break ;
  292.        case filesy   : *fsp=filetype(fsys,packedflag);  /* ファイル型 */
  293.                        fileflag = true ;
  294.       }
  295.      }
  296.      return(fileflag) ;
  297. }
  298.  
  299. /**************************************/
  300. /* pointertype() : ポインタ型の処理   */
  301. /**************************************/
  302. static stp *pointertype(Set fsys)
  303. {
  304.   stp *lsp ;
  305.   ctp *lcp ;
  306.   int ttop ;
  307.   Set ws   ;
  308.  
  309.      lsp = (stp*)Malloc(sizeof(stp)) ;  /* 型のエリア 確保            */
  310.      lsp->form = pointer ;
  311.      lsp->size = ptrsize ;
  312.      lsp->sf.pt.eltype =  nil  ;        /* とりあえずnilに            */
  313.  
  314.      insymbol() ;                       /* 次のsymbol(指し示す型名)   */
  315.      if(sy == ident) {
  316.       if(typevar) {                     /* 型定義部の処理の時         */
  317.        ttop = top ;
  318.        do {                             /* ブロック水準から型名を探す */
  319.         lcp = searchsection(display[top].fname) ;
  320.         if(lcp)
  321.          if(lcp->klass == types) break ;
  322.          else lcp = nil ;
  323.        } while(display[top--].occur != blck);
  324.        top = ttop ;
  325.        if(!lcp) lcp = searchsection(display[0].fname) ;
  326.                                         /* 標準名から探す             */
  327.        if(!lcp) {                       /* 見つからない(前方参照)     */
  328.         lcp = mkctp(id,types,lsp,fwptr);/*  名前エリアを型名で確保する*/
  329.         fwptr       = lcp    ;          /* forward pointerにつなぐ    */
  330.        }
  331.        else                             /* 見つかった時               */
  332.         lsp->sf.pt.eltype = lcp->idtype;/*  指し示すものの型          */
  333.       }
  334.       else {                            /* 変数定義部の処理の時       */
  335.        mkset(&ws, types, -1);
  336.        lcp = searchid(ws)   ;           /* 被指示型を探す             */
  337.        lsp->sf.pt.eltype = lcp->idtype; /*  指し示すものの型          */
  338.       }
  339.  
  340.       if(lsp->sf.pt.eltype)
  341.        if(!lsp->sf.pt.eltype->assignflag)
  342.         pcerr(608,"") ;                 /* 局所ファイルは駄目         */
  343.  
  344.       insymbol() ;
  345.      }
  346.      else pcerr(2,"") ;                 /* 名前がない                 */
  347.  
  348.      return(lsp) ;
  349. }
  350.  
  351. /**************************************/
  352. /* arraytype() : 配列型の処理         */
  353. /**************************************/
  354. static stp *arraytype(Set fsys,boolean packedflag,boolean *fileflag)
  355. {
  356.   stp *lsp,*lsp1,*lsp2 ;
  357.   int lsize = 1 ;
  358.   long range     ;
  359.   long lmin , lmax ;
  360.   Set ws ;
  361.   boolean test ;
  362.  
  363.      insymbol() ;
  364.      if(sy == lbrack) insymbol()   ;    /* [ ならば次のsymbolを読む   */
  365.      else             pcerr(11,"") ;    /* [ でなければ [がないエラー */
  366.  
  367.      lsp1 = nil ;
  368.      do {
  369.       lsp = (stp*)Malloc(sizeof(stp)) ;
  370.       lsp->form = arrays           ;
  371.       lsp->sf.ar.packed  = packedflag ; /* packed指定有無             */
  372.       lsp->sf.ar.aeltype = lsp1    ;    /* 要素の型は前の添え字の型   */
  373.       lsp->sf.ar.inxtype = nil     ;    /* 添え字の型の初期設定       */
  374.       lsp1 = lsp ;                      /* 次回のループのために退避   */
  375.  
  376.       mkset(&ws, comma,rbrack,ofsy,-1) ;
  377.       orset(&ws, &fsys) ;
  378.       simpletype(ws,&lsp2,&lsize)  ;    /* 添え字の型の処理           */
  379.       lsp1->size = lsize ;              /* 添え字の型の大きさ         */
  380.  
  381.       if(lsp2) {
  382.        if(lsp2->form <= subrange) {     /* 添え字の型がscalar,subrange*/
  383.         if(lsp2 == realptr) {           /*  実数型                    */
  384.          pcerr(109,"") ;                /*   ここでは実数型は駄目     */
  385.          lsp2 = nil    ;
  386.         }
  387.        }
  388.        else {                           /* 添え字の型がscalar,subrangeでない*/
  389.         pcerr(113,"") ;                 /*  添え字の型はスカラ､範囲型 */
  390.         lsp2 = nil    ;
  391.        }
  392.       } 
  393.       lsp->sf.ar.inxtype = lsp2 ;       /* 添え字の型を入れる         */
  394.  
  395.       if(test=(sy==comma)) insymbol() ; /* , なら次のsymbol           */
  396.      } while(test) ;                    /* , ならば繰り返す           */
  397.  
  398.      if(sy == rbrack) insymbol()   ;    /* ]  なら次のsymbol          */
  399.      else             pcerr(12,"") ;    /*  ] がない                  */
  400.      if(sy == ofsy)   insymbol()   ;    /* of なら次のsymbol          */
  401.      else             pcerr(8,"")  ;    /*  ofがない                  */
  402.  
  403.      *fileflag = typ(fsys,&lsp,&lsize); /* 要素の型の処理             */
  404.  
  405.      do {
  406.       lsp2 = lsp1->sf.ar.aeltype   ;    /* 1つ前の添え字の型          */
  407.       lsp1->sf.ar.aeltype = lsp    ;    /* 要素の型を入れる           */
  408.       if(lsp1->sf.ar.inxtype) {         /* 添え字の型がある時         */
  409.        getbounds(lsp1->sf.ar.inxtype,&lmin,&lmax) ; /* 型の最小,最大値*/
  410.        range = lmax - lmin + 1     ;    /* 1つの配列の大きさ          */
  411.        lsize = align(lsp,lsize) ;       /* 要素の型のサイズ境界       */
  412.        if(range && 
  413.           ((range > (long)Maxaddr) ||
  414.            ((long)lsize > (long)Maxaddr/range))) {
  415.         pcerr(605,inttoch((long)Maxaddr));    /* 型の大きさ制限       */
  416.         lsize = 0               ;       /* 以後同じエラーがでないよう */
  417.        } 
  418.        lsize = lsize * (int)range    ;
  419.        lsp1->size = lsize ;             /* その型までのサイズを入れる */
  420.       }
  421.       lsp  = lsp1 ;
  422.       lsp1 = lsp2 ;
  423.      } while(lsp1) ;
  424.  
  425.      lsp->size = ((lsize > 1) ? lsize : 1)  ;  /* 1以上のサイズの設定 */
  426.      return(lsp) ;
  427. }
  428.  
  429. /**************************************/
  430. /* recordtype() : レコード型の処理    */
  431. /**************************************/
  432. static stp *recordtype(Set fsys,boolean packedflag,boolean *fileflag)
  433. {
  434.   int oldtop ;                          /* displayのtopを退避しておく */
  435.   int disp1=0;                          /* レコード内相対番地         */
  436.   stp *lsp   ;                          /* レコード型のポインタ       */
  437.   stp *varp  ;                          /* 可変部の型 (ない時はnil)   */
  438.   Set ws1    ;
  439.   Set ws2    ;
  440.  
  441.      insymbol() ;
  442.      oldtop = top ;                     /* displayのtopを退避         */
  443.      if(top < Displimit) {              /*  最大ネスト数以下だったらOK*/
  444.       top++ ;
  445.       display[top].fname  = nil ;       /*  新しい水準のdisplayを初期化*/
  446.       display[top].flabel = nil ;
  447.       display[top].aname  = nil ;
  448.       display[top].occur  = rec ;       /*  レコード内定義            */
  449.      }
  450.      else pcerr(603,inttoch((long)Displimit)) ;
  451.                                         /* 名前の入れ子が深すぎる     */
  452.  
  453.      mkset(&ws1, endsy,-1) ;
  454.      orset(&ws1, &fsys)    ;
  455.      mkset(&ws2, semicolon,-1) ;        /* ws1 = fsys-[semicolon]     */
  456.      dfset(&ws1, &ws2)     ;            /*           +[endsy]         */
  457.      *fileflag = fieldlist(ws1,&varp,&disp1) ;
  458.                                         /* フィールドの処理           */
  459.  
  460.      lsp = (stp*)Malloc(sizeof(stp)) ;  /* レコードの型エリアへの設定 */
  461.      lsp->form = records ;
  462.      lsp->size = disp1   ;              /* レコードの大きさ           */
  463.      lsp->sf.re.packed = packedflag ;   /* packed指定有無             */
  464.      lsp->sf.re.fstfld = display[top].fname ; /* 最初の欄のアドレス   */
  465.      lsp->sf.re.recvar = varp ;         /* 可変部のアドレス(ない時はnil)*/
  466.  
  467.      top = oldtop ;                     /* displayの水準を戻す        */
  468.  
  469.      if(sy == endsy) insymbol() ;       /* endならば次のsymbol        */
  470.      else pcerr(13,"") ;                /*  end がない                */
  471.  
  472.      return(lsp) ;
  473. }
  474.  
  475. /**************************************/
  476. /* fieldlist() : レコードの欄の処理   */
  477. /**************************************/
  478. static boolean fieldlist(Set fsys,stp **frecvar,int *disp)
  479. {
  480.   ctp *lcp        ;
  481.   ctp *nxt        ;
  482.   ctp *nxt1 = nil ;
  483.   stp *lsp  = nil ;
  484.   int lsize       ;
  485.   Set ws          ;
  486.   Set ws2         ;
  487.   boolean fileflag = false ;
  488.   boolean test    ;
  489.  
  490.      mkset(&ws, ident, casesy, -1) ;
  491.      orset(&ws, &fsys) ;
  492.      if(! inset(ws,sy)) {               /* symbolがfsys,ident,caseでない*/
  493.       pcerr(19,"") ;                    /*  欄の並びに誤りがある        */
  494.       skip(ws)     ;                    /*  読み飛ばし                  */
  495.      }
  496.  
  497.      while(sy == ident) {               /* 固定部の処理               */
  498.       nxt = nxt1 ;
  499.       do {
  500.        if(sy == ident) {                /* 名前の時                   */
  501.         lcp = mkctp(id,field,nil,nxt) ; /* 名前エリアをfield属性で確保*/
  502.         enterid(lcp) ;
  503.         nxt = lcp ;
  504.         insymbol() ;                    /* 名前の次のsymbol           */
  505.        }
  506.        else pcerr(2,"") ;               /*  名前がない                */
  507.  
  508.        mkset(&ws, comma, colon, -1) ;
  509.        if(! inset(ws,sy)) {             /* , : でない時               */
  510.         pcerr(6,"")  ;                  /*  不当な記号が現れた        */
  511.         addset(ws,semicolon) ;
  512.         addset(ws,casesy)    ;
  513.         orset(&ws, &fsys) ;
  514.         skip(ws)     ;                  /* 読み飛ばし                 */
  515.        }
  516.  
  517.        if(test=(sy==comma)) insymbol(); /* , ならば次のsymbol         */
  518.       } while(test) ;                   /* , ならば繰り返す           */
  519.  
  520.       if(sy == colon) insymbol() ;      /* : ならば次のsymbol         */
  521.       else pcerr(5,"") ;                /*  : がない                  */
  522.  
  523.       mkset(&ws, casesy,semicolon,-1) ;
  524.       orset(&ws, &fsys)   ;
  525.       fileflag |= typ(ws,&lsp,&lsize) ; /* 名前の型の処理             */
  526.  
  527.       while(nxt != nxt1) {              /* 名前の列に型を入れる       */
  528.        nxt->idtype = lsp ;
  529.        *disp = align(lsp,*disp) ;
  530.        nxt->n.fldaddr = *disp   ;       /* レコード内の相対開始番地   */
  531.        if(Maxaddr-lsize < *disp)        /* 大きすぎる                 */
  532.         pcerr(605,inttoch((long)Maxaddr));   /* 型の大きさ制限        */
  533.        else *disp += lsize    ;
  534.        nxt = nxt->next   ;              /* 次の名前                   */
  535.       }
  536.       nxt1 = lcp  ;                     /* 次の型の名前の並びのために */
  537.  
  538.       mkset(&ws , ident,casesy,semicolon,-1) ;
  539.       orset(&ws , &fsys) ;
  540.       mkset(&ws2, ident,casesy,-1) ;
  541.       orset(&ws2, &fsys) ;
  542.       while(sy == semicolon) {
  543.        insymbol() ;
  544.        if(! inset(ws,sy)) {             /* symbolが名前,case,;でない時*/
  545.         pcerr(19,"") ;                  /*  欄の並びに誤りがある      */
  546.         skip(ws2) ;                     /*  読み飛ばし                */
  547.        }
  548.       }
  549.      }
  550.  
  551.      if(sy == casesy)                   /* caseが現れたら             */
  552.       fileflag |= varfield(fsys,frecvar,disp)  ;
  553.                                         /*   可変フィールドの処理     */
  554.      else  *frecvar = nil          ;    /* caseでなければ可変部はない */
  555.  
  556.      return(fileflag) ;     
  557. }
  558.  
  559. /**************************************/
  560. /* varfield() : 可変フィールドの処理  */
  561. /**************************************/
  562. static boolean varfield(Set fsys,stp **frecvar,int *disp)
  563. {
  564.   stp *lsp,*lsptag;
  565.   ctp *lcp=nil,*lcptag  ;
  566.   Set ws ;
  567.   char oldid[MaxIDlng+1] ;
  568.   enum symbol oldsy ;
  569.  
  570.      lsp = (stp*)Malloc(sizeof(stp)) ;
  571.      lsp->form = tagfld   ;             /* タグ欄用のエリア           */
  572.      lsp->sf.tg.tagfieldp = nil ;
  573.      lsp->sf.tg.tagtype   = nil ;
  574.      lsp->sf.tg.fstvar    = nil ;
  575.      *frecvar = lsp       ;             /* 可変部のタグ欄アドレス返却 */
  576.  
  577.      insymbol() ;
  578.      if(sy == ident) {
  579.       strcpy(oldid,id) ;
  580.       oldsy = sy;
  581.       insymbol() ;
  582.       if(sy == colon) {
  583.        lcp = mkctp(oldid,field,nil,nil) ; /* タグ名のエリア確保       */
  584.        lcp->n.fldaddr = *disp ;
  585.        enterid(lcp) ;
  586.        insymbol()   ;
  587.       }
  588.       else if(sy == ofsy) {             /* ofの時(タグ欄省略)         */
  589.        strcpy(id,oldid) ;
  590.        sy = oldsy       ;               /* 前読んだ名前は型名         */
  591.        oldsy = ofsy     ;
  592.       }
  593.       else  pcerr(5,"") ;               /*  : がない                  */
  594.       if(sy == ident) {                 /* 型名 の 処理               */
  595.        mkset(&ws, types, -1) ;
  596.        lcptag = searchid(ws)   ;        /* 型名からサーチする         */
  597.        applied(lcptag,level)   ;        /* 引用名チェーン             */
  598.        lsptag = lcptag->idtype ;        /* 型名の型                   */
  599.        if(lsptag) {                     /* 型がある場合               */
  600.         *disp = align(lsptag,*disp) ;   /* 型に適応した割りつけ開始番地*/
  601.         if(Maxaddr < *disp-lsptag->size)
  602.          pcerr(605,inttoch((long)Maxaddr)); /* 型の大きさ制限         */
  603.         if(lcp)                         /* タグ欄がある時は           */
  604.          lcp->n.fldaddr = *disp    ;    /* タグ欄の変位を設定         */
  605.         *disp += lsptag->size ;         /* 次の変位のためにサイズ分進める*/
  606.                                         /* タグ欄がなくても場所は確保 */
  607.         if((lsptag->form <= subrange ) &&
  608.            (lsptag != realptr)) {       /* 順序型                     */
  609.          if(lcp) lcp->idtype = lsptag ; /* タグの型アドレス           */
  610.          lsp->sf.tg.tagfieldp     = lcp    ;
  611.          lsp->sf.tg.tagtype       = lsptag ;
  612.         }
  613.         else pcerr(110,"") ;            /* タグの型は順序型以外は駄目 */
  614.        }
  615.        if(oldsy != ofsy) insymbol() ;   /* of を読む                  */
  616.        else sy = oldsy ;                /* すでにofを読んでいる時     */
  617.       }
  618.       else pcerr(2,"") ;                /* 名前がない                 */
  619.      }
  620.      else {                             /* caseの次が名前でない場合   */
  621.       pcerr(2,"") ;                     /*  名前がない                */
  622.       mkset(&ws, ofsy, lparent, -1) ;
  623.       orset(&ws, &fsys) ;
  624.       skip(ws) ;                        /* 読み飛ばし                 */
  625.      }
  626.  
  627.      lsp->size = *disp ;                /* タグ欄のまでの大きさ       */
  628.  
  629.      if(sy == ofsy) insymbol() ;        /* ofなら次のsymbol           */
  630.      else pcerr(8,"") ;                 /*  ofがない                  */
  631.  
  632.      return(varelement(fsys,lsptag,&(lsp->sf.tg.fstvar),&disp));
  633.                                         /* 可変要素の処理             */
  634. }
  635.  
  636. /**************************************/
  637. /* varelement() : 可変要素の処理      */
  638. /**************************************/
  639. static boolean varelement(Set fsys,stp *fsptag,stp **fsp,int **disp)
  640. {
  641.   stp *lspconst,*lspfield,*lspvar=nil ;
  642.   stp *lsp1,*lsp2,*lsp4,*lsp5,*lsp6 ;
  643.   union valu lvalu ;
  644.   int minsize, maxsize ,ldisp ;
  645.   long range ;                          /* タグ型の取りえる要素の合計 */
  646.   long itemsu=0;                        /* 選択定数の指定数           */
  647.   Set ws ;
  648.   boolean fileflag = false ;
  649.   boolean test ;
  650.   boolean ok   ;
  651.  
  652.      range = (fsptag->form == subrange) 
  653.             ? fsptag->sf.su.max - fsptag->sf.su.min + 1  /* 範囲型の時*/ 
  654.             : fsptag->sf.sc.fconst->n.values.ival+1 ;    /* 列挙型の時*/
  655.      lsp1    = lsp4 = nil   ;
  656.      maxsize = minsize = ldisp = **disp ;
  657.  
  658.      do {
  659.       lsp2 = nil ;
  660.       do {
  661.        ok = false ;
  662.        mkset(&ws, comma,colon,lparent,-1) ;
  663.        orset(&ws, &fsys) ;
  664.        constant(ws,&lspconst,&lvalu) ;  /* 選択定数                   */
  665.        if(string(lspconst) || (lspconst==realptr)) /* 文字列､実数型   */
  666.         pcerr(159,"") ;                 /* 文字列､実数型は指定不可    */
  667.        else if(fsptag) {                /* タグ型がある時のみチェック */
  668.         if(! compatible(fsptag,lspconst))
  669.          pcerr(111,"")  ;               /* 見出しの型と一致していない */
  670.         else {
  671.          ok = true ;
  672.          if(fsptag->form == subrange)   /* 部分範囲型の時             */
  673.           if((lvalu.ival < fsptag->sf.su.min) ||  /* 最小値           */
  674.              (lvalu.ival > fsptag->sf.su.max)) {  /* 最大値チェック   */
  675.            pcerr(111,"") ;              /* 見出しの型と一致していない */
  676.            ok = false ;
  677.           }
  678.          while(lsp4) {                /* 重複指定チェック           */
  679.           if(lsp4->sf.vr.varval == lvalu.ival) {  /*    値が同じ      */
  680.            pcerr(178,"") ;            /* 同じものが定義された       */
  681.            ok = false ;
  682.           }
  683.           lsp4 = lsp4->sf.vr.nextvr ;
  684.          }
  685.         }
  686.        }
  687.        if(ok) {                         /* 選択定数が正しいものの時   */
  688.         itemsu++ ;                      /*  定数の数を数える          */
  689.         lspvar = (stp*)Malloc(sizeof(stp));
  690.         lspvar->form         = variant    ;
  691.         lspvar->sf.vr.nextvr = lsp1       ;
  692.         lspvar->sf.vr.subvar = lsp2       ;
  693.         lspvar->sf.vr.varval = lvalu.ival ;/* 選択定数の値             */
  694.         lsp1 = lsp2 = lsp4 = lspvar ;
  695.        }
  696.        if(test=(sy==comma)) insymbol(); /* , ならば次の名札           */
  697.       } while(test) ;
  698.       if(sy == colon) insymbol() ;      /* : ならば次のsymbol         */
  699.       else pcerr(5,"") ;                /*  : がない                  */
  700.       if(sy == lparent) insymbol() ;    /* ( ならば次のsymbol         */
  701.       else pcerr(9,"") ;                /*  ( がない                  */
  702.       mkset(&ws, rparent,semicolon,-1);
  703.       orset(&ws, &fsys) ;
  704.       fileflag |= fieldlist(ws,&lspfield,&ldisp) ;
  705.                                         /* フィールドの処理           */
  706.       if(ldisp > maxsize) maxsize = ldisp ;
  707.       lsp5 = lspvar                 ;
  708.       while(lsp5) {
  709.        lsp6 = lsp5->sf.vr.subvar     ;
  710.        lsp5->sf.vr.subvar = lspfield ;
  711.        lsp5->size         = ldisp    ;
  712.        lsp5               = lsp6     ;
  713.       }
  714.       if(sy == rparent) {
  715.        insymbol() ;
  716.        ws = fsys ;
  717.        addset(ws,semicolon) ;
  718.        if(! inset(ws,sy)) {
  719.         pcerr(6,"") ;                   /*  不当な記号が現れた        */
  720.         skip(ws)    ;                   /*  fsys+[semicolon]まで読み飛ばし*/
  721.        }
  722.       }
  723.       else pcerr(4,"") ;                /*  ) がない                  */
  724.       if(sy == semicolon) {
  725.        ldisp = minsize ;
  726.        insymbol() ;
  727.       }
  728.      } while(! inset(fsys,sy)) ;        /* ; end fsys でなければループ*/
  729.  
  730.      if(itemsu != range) pcerr(179,"") ;/* タグ型で取りえるすべての選択定数
  731.                                            が指定されていない              */
  732.      *fsp   = lspvar  ;
  733.      **disp = maxsize ;
  734.      return(fileflag) ;
  735. }
  736.  
  737. /**************************************/
  738. /* settype() : 集合型の処理           */
  739. /**************************************/
  740. static stp *settype(Set fsys,boolean packedflag)
  741. {
  742.   stp *lsp, *lsp1 ;
  743.   int lsize = 1 ;
  744.   long lmin , lmax ;
  745.  
  746.      insymbol() ;
  747.      if(sy == ofsy) insymbol() ;        /* of なら次のsymbol          */
  748.      else pcerr(8,"")          ;        /*  ofがない                  */
  749.      
  750.      simpletype(fsys,&lsp1,&lsize) ;    /* 基底の型は単純型           */
  751.  
  752.      if(lsp1) {
  753.       if((lsp1->form > subrange) ||     /* scalar,範囲型ではない      */
  754.           (lsp1 == realptr)) {          /* 実数型                     */
  755.        pcerr(115,"")  ;                 /*  基底の型が順序型でない　  */
  756.        lsp1 = nil     ;
  757.       }
  758.       else {                            /* 列挙型､範囲型の時          */
  759.        getbounds(lsp1,&lmin,&lmax) ;    /* 型の最小値､最大値を求める  */
  760.        if((lmin < (long)setlow) ||
  761.           ((long)sethigh < lmax))       /* 集合の要素数チェック       */
  762.         pcerr(606,inttoch((long)sethigh)) ;/*  基底型の順序数範囲越え */
  763.       }
  764.      }
  765.  
  766.      lsp = (stp*)Malloc(sizeof(stp)) ;
  767.      lsp->form = power       ;          /* 集合型                     */
  768.      lsp->size = setsize     ;          /* 集合の大きさ               */
  769.      lsp->sf.pw.packed= packedflag ;    /* packed指定有無             */
  770.      lsp->sf.pw.elset = lsp1 ;          /* 要素の型                   */
  771.      lsp->sf.pw.elmin = (int)lmin ;     /* 要素の最小値               */
  772.      lsp->sf.pw.elmax = (int)lmax ;     /* 要素の最大値               */
  773.      return(lsp)             ;
  774. }
  775.  
  776. /**************************************/
  777. /* filetype() : ファイル型の処理      */
  778. /**************************************/
  779. static stp *filetype(Set fsys,boolean packedflag)
  780. {
  781.    stp *lsp,*lsp1 ;
  782.    int lsize ;
  783.    boolean fileflag ;
  784.    
  785.      insymbol()    ;
  786.      if(sy == ofsy) insymbol() ;
  787.      else pcerr(8,"") ;                 /* of がない                  */
  788.      fileflag = typ(fsys,&lsp1,&lsize) ;/* 基底の型の処理             */
  789.      if(fileflag) pcerr(112,"") ;       /* 代入可能な型でない         */
  790.      
  791.      lsp = (stp*)Malloc(sizeof(stp)) ;
  792.      lsp->form = files ;                /* ファイル型                 */
  793.      lsp->size = lsp1->size ;           /* 基底の型の大きさ           */
  794.      lsp->sf.fi.packed = packedflag ;   /* packed指定有無             */
  795.      lsp->sf.fi.texttype = false    ;   /* file of ～ は text型でない */
  796.      lsp->sf.fi.filtype  = lsp1     ;   /* 基底の型                   */
  797.      
  798.      return(lsp) ; 
  799. }
  800.  
  801. /**************************************/
  802. /* packedtype() : packed の処理       */
  803. /**************************************/
  804. static boolean packedtype(Set fsys)
  805. {
  806.   boolean packedflag ;                  /* packed 指定の時 true       */
  807.   Set ws ;
  808.  
  809.      if(packedflag=(sy == packedsy)) {  /* packedの記述がある時       */
  810.       insymbol() ;                      /* 次のsymbolを読む           */
  811.       if(! inset(typedels,sy)) {        /*  array,record,set,file以外 */
  812.        pcerr(10,"")  ;                  /*   型の記述に誤りがある     */
  813.        ws = fsys ;
  814.        orset(&ws,&typedels) ;
  815.        skip(ws)  ;                      /* fsys+typedlesまで読み飛ばし*/
  816.       }
  817.      }
  818.      return(packedflag) ;
  819. }
  820.